unit Supply;

interface
uses
 Types, Classes, SysUtils, Math, AsphyreDef, Windows;

type
TTree = class
protected
  FTreeNextRight:TTree;
  FTreeNextLeft:TTree;
  FTreeLast:TTree;
  FSeen:boolean;
  procedure SetRight(value:integer);
  procedure SetLeft(value:integer);
public
  FIndex:integer;
  property Seen:boolean read FSeen write FSeen default false;
  property Right:integer write SetRight;
  property Left:integer write SetLeft;
end;

TRect2=record
  top,left,right,bottom:real;
end;

TNamedCount=record
  Name:String;
  Count:integer;
end;

TArrayNC=array of TNamedCount;

function BoolToByte(F:boolean):byte;
function cColorAlpha1(Color, Alpha: Cardinal): cardinal;
function MoveToAngle(Direct,a1:real;step:real):real;
function MoveToValue(Value,a,step:real):real;
function AngleDifference(a1,a2:real):real;
Function Decode(S: String; Code: Integer): String;
function MixColors(Color1,Color2:cardinal; Theta:real):cardinal;
procedure AddNamedCount(s:string; Count:integer; var A:TArrayNC);
procedure ChangeNamedCount(s:string; Change:integer; var A:TArrayNC);
function GetNamedCount(s:string; var A:TArrayNC):integer;
function InvertColor(C:cardinal):cardinal;

implementation


procedure TTree.SetRight(value:integer);
begin
  FTreeNextRight:=TTree.Create;
  FTreeNextRight.FTreeLast:=self;
  FTreeNextRight.FIndex:=value;
end;

procedure TTree.SetLeft(value:integer);
begin
  FTreeNextLeft:=TTree.Create;
  FTreeNextLeft.FTreeLast:=self;
  FTreeNextLeft.FIndex:=value;
end;

function cColorAlpha1(Color, Alpha: Cardinal): cardinal;
begin
 Result:= (Color and $FFFFFF) or ((Alpha and $FF) shl 24);
end;



function MoveToAngle(Direct,a1:real;step:real):real;
var
Direction,a:real;
begin
  Direction:=Direct;
  a:=a1;
  if a>256 then
  a:=a-256;
  if a<0 then
  a:=256+a;
  if Direction>256 then
  Direction:=Direction-256;
  if Direction<0 then
  Direction:=256+Direction;
  if (((Direction>a)and not(Direction-128>a))or
  ((a-128)>Direction)and(Direction<>a)) then
  begin
    Direction:=Direction-Min(step,round(abs(a-Direction)));
    if Direction<0 then Direction:=255+Direction;
  end
  else
  if (Direction<a)or((Direction-128>a)and(Direction<>a)) then
  begin
    Direction:=Direction+Min(step,round(abs(a-Direction)));
    if Direction>255 then Direction:=Direction-255;
  end;

  if Direction<0 then Direction:=255+Direction;
  if Direction>255 then Direction:=Direction-255;

  Result:=Direction;
end;

function AngleDifference(a1,a2:real):real;
begin
  if a1>256 then
  a1:=a1-256;
  if a1<0 then
  a1:=256+a1;
  if a2>256 then
  a2:=a2-256;
  if a2<0 then
  a2:=256+a2;
  if abs(a1-a2)>128 then
  result:=256-abs(a1-a2)
  else
  result:=abs(a1-a2);
end;

function MoveToValue(Value,a,step:real):real;
begin
  if a<Value then
  result:=a+min(step,value-a)
  else
  result:=a-min(step,a-value);
end;

function MixColors(Color1,Color2:cardinal; Theta:real):cardinal;
var
Pix1:array[1..4] of byte;
d: array [1..4] of integer;
begin
      Pix1[1] := GetRValue(Color1);

      Pix1[2] := GetGValue(Color1);
      Pix1[3] := GetBValue(Color1);
      Pix1[4] := GetAValue(Color1);


      d[1] := Pix1[1] -
        GetRValue(Color2);
      d[2] := Pix1[2] -
        GetGValue(Color2);
      d[3] := Pix1[3] -
        GetBValue(Color2);
      d[4] := Pix1[4] -
        GetAValue(Color2);

       Result := cRGB1(
          round(Pix1[1] - d[1] * Theta ),
          round(Pix1[2] - d[2] * Theta ),
          round(Pix1[3] - d[3] * Theta ),
          round(Pix1[4] - d[4] * Theta ));

end;

procedure AddNamedCount(s:string; Count:integer; var A:TArrayNC);
var
z:integer;
begin
  z:=Length(A);
  SetLength(A,z+1);
  A[z].Name:=s;
  A[z].Count:=Count;
end;

procedure ChangeNamedCount(s:string; Change:integer; var A:TArrayNC);
var
i:integer;
B:boolean;
begin
  B:=false;

  for i:=0 to length(A)-1 do
  if A[i].Name=s then
  begin
    inc(A[i].Count,Change);
    B:=true;
  end;

  if B=false then
  AddNamedCount(s,Change,A);
end;

function GetNamedCount(s:string; var A:TArrayNC):integer;
var
i:integer;
begin
  result:=0;
  for i:=0 to length(A)-1 do
  if A[i].Name=s then
  begin
    Result:=A[i].Count;
    exit;
  end;
  AddNamedCount(s,0,A);
end;

function InvertColor(C:cardinal):cardinal;
begin
 result:=cRGB1(GetAValue(c),GetGValue(c),GetBValue(c),GetRValue(c));
end;

Function Decode(S: String; Code: Integer): String;
Var t: Integer;
Begin
  For t:=1 to Length(S) Do S[t]:=Chr(Ord(S[t]) xor Code);
  Result:=S;
End;

function BoolToByte(F:boolean):byte;
begin
  if F then
  result:=1
  else
  result:=0;
end;

end.




